home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Brotikasten
/
BROTCD01.iso
/
c128
/
c156.d64
/
disk base
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-08-09
|
5KB
|
149 lines
100 REM ------------------------------
110 REM >CREATING NEW DATA FILES USE: _
120 REM >BUT NO MORE THEN 22 DATA FILES
130 REM ------------------------------
140 REM
150 REM DISK BASE
160 REM BEWERKT DOOR H.PIETERS,
170 REM HOOFDDORP (NL)2503-14160
180 REM
190 POKE53280,0:POKE53281,0:POKE808,251: PRINT"[147]"
200 DIMNA$(999),FL$(300),D$(300),C$(300)
210 GOSUB980:IFI=1THENGOTO330
220 INPUT" NEW DATA FILE NAME ";DR$:DR$="-"+DR$:GOTO420
230 PRINTTAB(12)"INPUT.........1":PRINTTAB(12)"SHOW..........2":
240 PRINTTAB(12)"SEARCH........3":PRINTTAB(12)"SAVE..........4"
250 PRINTTAB(12)"PRINT.........5":PRINTTAB(12)"OTHER DATA....6"
260 PRINTTAB(12)"END...........7"
270 GETA$:IFA$=""ORVAL(A$)<1ORVAL(A$)>7 THEN270
280 ONVAL(A$)GOTO420,680,1180,850,1390,290,1290
290 CLR:RUN
300 REM******************************
310 REM LOADING
320 REM******************************
330 PRINT"" TAB(0)" CURSOR ON DATA FILE: "
340 POKE19,64:INPUTDR$:POKE19,0: DR$="-"+DR$:IFDR$="-_"THEN220
350 OPEN8,8,8,DR$+",S,R"
360 INPUT#8,K:FORT=1TOK:INPUT#8,NA$(T)
370 NEXTT:CLOSE8:IFK=0THENPRINT"[147]NO DATA FILE ":FORT=1TO1000:NEXT:CLR:RUN
380 GOSUB390:GOTO230
390 PRINT"[147] D I S K -- B A S E "
400 PRINT" [169][223][169][223][169][223][169][223][169][223][169][223][169][223][169][223][169][223][169][223][169][223][169][223][146]"
410 PRINTTAB(19-(LEN(DR$)+11)/2)"DATA FILE = "MID$(DR$,2,20)" [146]":RETURN
420 REM******************************
430 REM INPUT
440 REM******************************
450 GOSUB390:PRINT" _ = MENU "
460 INPUT"NAME PRG.(MAX.18) ";NA$:IFNA$="_"THENGOSUB390:GOTO230
470 IFLEN(NA$)>18ORNA$=""THENPRINT"[145][145][145]":GOTO460
480 PRINT" "NA$" [146]"
490 INPUT"DISK NR. ";FL$
500 IFFL$="_"THENGOSUB390:GOTO230
510 IFLEN(FL$)>5ORFL$=""THENPRINT"[145][145][145]":GOTO490
520 O$=" "
530 NA$=NA$+O$:NA$=LEFT$(NA$,21)+" "+FL$
540 PRINT" INPUT OK Y/N ? "
550 GETA$:IFA$=""OR(A$<>"Y"ANDA$<>"N")THEN550
560 IFA$="N"THENPRINT"[147]":GOTO420
570 POKE53296,1:PRINT:PRINT"WORKING"
580 K=K+1:NA$(K)=NA$ :M=1
590 FORJ=KTO1STEP-1:V$=NA$(J):W$=NA$(J-1)
600 IFV$>W$THEN620
610 NA$(J)=W$:NA$(J-1)=V$
620 :NEXT
630 PRINT"[147]":POKE53296,0:GOTO910
640 PRINT"[145] MORE ? ' "MID$(DR$,2,15)" ' Y/N "
650 GETA$:IFA$=""OR(A$<>"Y"ANDA$<>"N")THEN650
660 IFA$="Y"THENPRINT"[147]":GOTO420
670 PRINT"[147]":GOTO910
680 REM******************************
690 REM SHOW
700 REM******************************
710 GOSUB390:GOSUB840
720 FORT=1TOK:PRINTTTAB(5)NA$(T) :B=B+1:IFB=15THENGOSUB750
730 IFT=KTHENPRINT" LAST RECORD "
740 NEXT:GOSUB760:GOSUB390:GOTO230
750 IFT=KTHENPRINT" LAST RECORD "
760 PRINT" SCRATCH Y/N ? _ = MENU ":B=0
770 GETA$:IFA$=""OR(A$<>"N"ANDA$<>"Y"ANDA$<>"_"ANDA$<>" ")THEN770
780 IFA$="N"ORA$=" "THENGOSUB390:GOSUB840:RETURN
790 IFA$="_"THENGOSUB390:GOTO230
800 INPUT"[145] SCRATCH WHICH NUMBER ";T
810 IFK=1THENRETURN
820 FORM=TTOK:NA$(M)=NA$(M+1):NEXT:K=K-1:M=1:GOTO910
830 GOSUB390:GOSUB840:RETURN
840 PRINT" NAME PRG. "TAB(23)" DISK NR. ":B=0:RETURN
850 REM******************************
860 REM SAVE
870 REM******************************
880 GOSUB390:PRINT"SAVE ... ARE YOU SURE Y/N ? "
890 GETA$:IFA$=""OR(A$<>"Y"ANDA$<>"N")THEN890
900 IFA$="N"THENGOSUB390:GOTO230
910 OPEN8,8,8,"@:"+DR$+",S,W"
920 GOSUB390:PRINT" WRITING "
930 PRINT#8,K:FORT=1TOK:PRINT#8,NA$(T)
940 NEXTT:CLOSE8:M=0:GOTO290
950 REM******************************
960 REM DIR
970 REM******************************
980 OPEN15,8,15,"10":OPEN2,8,2,"#":M=0
990 T=18:S=1:PRINT"[147] STAND BY ":I=0
1000 PRINT#15,"U1";2;0;T;S
1010 PRINT#15,"B-P";2;0
1020 GET#2,X$:IFX$=""THENX$=CHR$(0)
1030 T=ASC(X$)
1040 GET#2,X$:IFX$=""THENX$=CHR$(0)
1050 S=ASC(X$):FORX=0TO7
1060 PRINT#15,"B-P";2;X*32+2
1070 GET#2,X$:IFX$=""THENX$=CHR$(0)
1080 IFASC(X$)=0THEN1150
1090 PRINT#15,"B-P";2;X*32+5:FF$=""
1100 FORY=0TO15:GET#2,X$:IFX$=""THENX$=CHR$(0)
1110 IFASC(X$)=160THEN1140
1120 FF$=FF$+X$:IFLEFT$(FF$,1)<>"-"THENY=15:GOTO1150
1130 NEXTY
1140 PRINTMID$(FF$,2,15):I=1
1150 NEXTX
1160 IFT<>0THEN1000
1170 CLOSE1:CLOSE15:RETURN
1180 REM******************************
1190 REM SEARCH
1200 REM******************************
1210 GOSUB390:INPUT"SEARCH NAME (PART) ";Z$:L=LEN(Z$)
1220 GOSUB390:PRINT" NAME PRG. "TAB(18)" DISK NR. "
1230 FORJ=1TOK:IFLEFT$(NA$(J),L)<>Z$THEN1250
1240 PRINTNA$(J):W=1
1250 NEXT:IFW=0THENPRINT"[145][145][145][145][145]"
1260 PRINT" NO (MORE) '"Z$"' [146] (- KEY -)"
1270 GETA$:IFA$=""THEN1270
1280 GOSUB390:GOTO230
1290 REM******************************
1300 REM END
1310 REM******************************
1320 IFM=1THENPRINT"[147]THERE IS A CHANGE SAVE Y/N ?"
1330 IFM=1THEN GETA$:IFA$=""OR(A$<>"Y"ANDA$<>"N")THEN1330
1340 IFM=1ANDA$="Y"THENGOSUB390:GOTO230
1350 GOSUB390:PRINT" ARE YOU SURE ? Y/N "
1360 GETA$:IFA$=""OR(A$<>"N"ANDA$<>"Y")THEN1360
1370 IFA$="N"THENGOSUB390:GOTO230
1380 PRINT"[147]SO LONG ":POKE808,237: CLR:END
1390 REM******************************
1400 REM PRINTER
1410 REM******************************
1420 PRINT"[147]":OPEN4,4:CLOSE4:IFST<>-128THEN1460
1430 PRINT" PRINTER ON + KEY "
1440 GETA$:IFA$=""THENPRINT"[145][145]":GOTO1430
1450 GOTO1420
1460 GOSUB390
1470 S=INT(K/2):V=K-S:P=0
1480 FORM=1TOS+1:C$(M)=NA$(M):NEXT
1490 FORW=VTOK:D$(P)=NA$(W):P=P+1: NEXT
1500 L$=CHR$(10):W$=CHR$(14):S$=CHR$(15):P$=CHR$(16)
1510 OPEN4,4:PRINT#4,W$P$"25"MID$(DR$,2,20)
1520 PRINT#4,
1530 PRINT#4,S$P$"10NAME"P$"32NR"P$"48NAME"P$"70NR"
1540 PRINT#4,P$"10[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]";
1550 PRINT#4,P$"48[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
1560 FORT=1TOP:PRINT#4,P$"10"C$(T)P$"48" D$(T):NEXT:PRINT#4,:PRINT#4,:CLOSE4
1570 GOSUB390:GOTO230